home *** CD-ROM | disk | FTP | other *** search
/ Libris Britannia 4 / science library(b).zip / science library(b) / MEDICAL / 2608A.ZIP / GP.ZIP / CHECKIM.SRC < prev    next >
Text File  |  1990-11-03  |  7KB  |  325 lines
  1. ;\|
  2. ;CHECKIM.SRC     Translated from CHECKIM.EDT by Roger Mathew's EDT2SRC Ver 4.11
  3. ;NEW      00:35:59 AM  27/11/89
  4. DO_DEFINES:
  5.    define(TD|D|10||)
  6.    define(CALC2|N|5|2|)
  7.    define(CALC|N|5|2|)
  8.    define(AGE|N|6|2|)
  9.    define(REC_DATE|N|4||)
  10.    define(REC_FIELD|A|15||)
  11.    define(FLAG1|N|2||)
  12.    define(TOT_RECORDS|N|8||)
  13.    define(TARGET|N|3||)
  14.    define(TO_DATE|S|8||)
  15.    define(NUMBER|N|8||)
  16.    define(PAGE|N|5||)
  17.    define(SELECT_FROM1|D|10||)
  18.    define(SELECT_THRU1|D|10||)
  19.    define(SELECT_DR|N|1||)
  20.    define(SORT_BY|N|5||)
  21.    define(PERCENT1|N|6|2|)
  22.    define(PERCENT|N|6|2|)
  23.    define(SORT_BY_TEXT|A|15||)
  24.    define(AGE1|N|6|2|)
  25.    define(MENU_HLDR|A|27||5)
  26.    define(MATCHING_RECS|N|4||)
  27. OPEN_FILES:
  28.    open(RECALLS|||)
  29.    open(PATIENT|||)
  30.    date(TD|G)
  31.    trap(Q|G|EXIT2)
  32. MOUNT_SCR:
  33.    mount(SELECT|S)
  34.    pmsg(" F1 - Help                                                           ESC - Exit "|1|25|N|Y|S|)
  35. START:
  36.    SORT_BY_TEXT = (DATE.OF.BIRTH)
  37.    enter(TO_DATE||||N|N|N|||N)
  38.    SELECT_THRU1 = (TO_DATE-90)
  39.    SELECT_FROM1 = (TO_DATE-2190)
  40.    SELECT_DR = (1)
  41.    enter(SELECT_FROM1|||START|||||)
  42.    enter(SELECT_THRU1||||||||)
  43. MOUNT_RPT:
  44.    trap(I|G|EXIT2)
  45.    trap(P|S|PRT_TOF)
  46.    mount(NEW|R|P)
  47. FIND_FIRST:
  48.    DATE.OF.BIRTH = (SELECT_FROM1)
  49.    find(G|DATE.OF.BIRTH|NO_RECS|)
  50. PRT_DETAIL:
  51.    if SELECT_DR <> (0) then if DOCTOR <> (SELECT_DR) goto FIND_NEXT
  52.    if SELECT_FROM1 <> (0) then if DATE.OF.BIRTH < (SELECT_FROM1) goto FIND_NEXT
  53.    if SELECT_THRU1 <> (0) then if DATE.OF.BIRTH > (SELECT_THRU1) goto FINISH
  54.    gosub DO_RELATED
  55.    TOT_RECORDS = (TOT_RECORDS + 1)
  56. FIND_NEXT:
  57.    find(N|PATIENT|FINISH)
  58.    goto PRT_DETAIL
  59. ABORT_RPT:
  60.    pmsg(""|||N|N|D|)
  61.    pmsg(""|||N|N|D|)
  62.    pmsg(">>>>>  Report was terminated before completion  <<<<<"|||N|N|D|)
  63.    pmsg(""|||N|N|D|)
  64.    pmsg(""|||N|N|D|)
  65. FINISH:
  66.    pblnk(2)
  67.    PERCENT1 = (MATCHING_RECS/TOT_RECORDS*100)
  68.    PERCENT = (100-PERCENT1)
  69.    pmsg("        TOTAL RECORDS MATCHING ";TOT_RECORDS|||N|N|D|)
  70.    pmsg("           RECORDS PRINTED; ";MATCHING_RECS|||N|N|D|)
  71.    pmsg("     PERCENTAGE COMPLETED ON TIME ETC: ";PERCENT|||N|N|P|)
  72.    PERCENT = (CALC-CALC2/CALC*100)
  73.    pmsg("PERCENTAGE COMPLETED BY FPC CRITERIA: ";PERCENT|1|1|N|N|P|)
  74.    trap(P|D)
  75.    ptof
  76. EXIT:
  77.    SELECT_DR = (SELECT_DR+1)
  78.    if SELECT_DR > (4) then run("recmenu")
  79.    MATCHING_RECS = (0)
  80.    TOT_RECORDS = (0)
  81.    CALC = (0)
  82.    CALC2 = (0)
  83.    PERCENT = (0)
  84.    PERCENT1 = (0)
  85.    goto MOUNT_RPT
  86. EXIT2:
  87.    run("recmenu")
  88. DO_RELATED:
  89.    COD[3] = ("")
  90.    COD.D[3] = (0)
  91.    REC_FIELD = ("")
  92.    COD.REF = (RECORD.NUMBER)
  93.    find(M|COD.REF|NO_RFIND|N)
  94.    if COD[3] = ("B") do
  95.       {
  96.       CALC = (CALC+1)
  97.       ret
  98.       }
  99.    if COD.D[3] > (TO_DATE) ret
  100. NEXT_TO:
  101.    gosub CHK_BREAK
  102.    ret
  103. PRT_TOF:
  104.    pset(130|66|60)
  105.    pchr(P|1)
  106.    pfmt(1||||)
  107.    pfmt(3|||N|N|)
  108.    pfmt(5|||N|N|)
  109.    pfmt(6|||N|N|)
  110.    pfmt(7|||N|N|)
  111.    pfmt(3|||N|N|)
  112.    pfmt(2|||N|N|)
  113.    pfmt(3|||N|N|)
  114.    ret
  115. CHK_BREAK:
  116.    if TO_DATE > (0) do
  117.       {
  118.       NUMBER = (TO_DATE-DATE.OF.BIRTH)
  119.       }
  120.    else
  121.       {
  122.       NUMBER = (TD-DATE.OF.BIRTH)
  123.       }
  124.    AGE1 = (365/12)
  125.    AGE = (NUMBER/AGE1/12)
  126.    if AGE < (6) do
  127.       {
  128.       if AGE > (4.99) do
  129.          {
  130.          CALC = (CALC+1)
  131.          gosub RECALC
  132.          }
  133.       }
  134.    if AGE < (3) do
  135.       {
  136.       if AGE > (1.99) do
  137.          {
  138.          CALC = (CALC+1)
  139.          gosub RECALC2
  140.          }
  141.       }
  142.    if COD[3] = ("1") goto BOOSTER
  143.    if COD[3] = ("2") goto BOOSTER
  144.    if COD[3] = ("3") goto BOOSTER
  145.    if COD[3] = ("M") goto BOOSTER
  146.    if COD[3] = ("B") goto BOOSTER
  147.    if COD[3] = ("BND") goto BOOSTER
  148.    REC_FIELD = ("EXCEPTION")
  149.    goto RET_PRINT
  150. BOOSTER:
  151.    if NUMBER > (1642) do
  152.       {
  153.       if COD[3] = ("M") do
  154.          {
  155.          REC_FIELD = ("?BOOSTER")
  156.          goto RET_PRINT
  157.          }
  158.       else
  159.          {
  160.          if COD[3] = ("BND") do
  161.             {
  162.             REC_FIELD = ("?BOOSTER")
  163.             goto RET_PRINT
  164.             }
  165.          }
  166.       else
  167.          {
  168.          if COD[3] = ("3") do
  169.             {
  170.             REC_FIELD = ("?BOOSTER")
  171.             goto RET_PRINT
  172.             }
  173.          }
  174.       }
  175.    if NUMBER > (456) do
  176.       {
  177.       if COD[3] = ("3") do
  178.          {
  179.          REC_FIELD = ("?MMR/BSTR")
  180.          goto RET_PRINT
  181.          }
  182.       }
  183.    if NUMBER > (334) do
  184.       {
  185.       if COD[3] = ("2") do
  186.          {
  187.          REC_FIELD = ("?3RD TRP")
  188.          goto RET_PRINT
  189.          }
  190.       }
  191.    if NUMBER > (152) do
  192.       {
  193.       if COD[3] = ("1") do
  194.          {
  195.          REC_FIELD = ("?2ND TRP")
  196.          goto RET_PRINT
  197.          }
  198.       }
  199.    if NUMBER > (91) do
  200.       {
  201.       if COD[3] = ("") do
  202.          {
  203.          REC_FIELD = ("?1ST TRP")
  204.          goto RET_PRINT
  205.          }
  206.       }
  207.    ret
  208. RET_PRINT:
  209.    MATCHING_RECS = (MATCHING_RECS+1)
  210.    pfmt(4|||N|N|)
  211.    ret
  212. NO_RECS:
  213.    goto EXIT
  214. NO_RFIND:
  215.    COD.REF = (0)
  216.    TOT_RECORDS = (TOT_RECORDS+1)
  217.    REC_FIELD = ("NO RECALL???")
  218.    pfmt(4|||N|N|)
  219.    pops
  220.    goto FIND_NEXT
  221.    ret
  222. RECALC:
  223.    if COD[3] = ("B") ret
  224.    CALC2 = (CALC2+1)
  225.    ret
  226. RECALC2:
  227.    if COD[3] = ("M") ret
  228.    CALC2 = (CALC2+1)
  229.    ret
  230. \STSELECT  
  231.                              Selection Screen For
  232.                    IMMUNISATION RESULTS FOR VARIOUS AGE GROUPS
  233. ════════════════════════════════════════════════════════════════════════════════
  234.  
  235. THIS WILL GIVE A PRINT OF EACH DOCTORS OUTSTANDING IMMUNISATIONS UP TO TODAY.
  236.  
  237. ────────────────────────────────────────────────────────────────────────────────
  238.  
  239.                           Doctor : &           1,2,3,4
  240.     Where DATE.OF.BIRTH   is From: &           Always enter Oldest to
  241.       and DATE.OF.BIRTH   is Thru: &           youngest.
  242.   ENTER DATE YOU WANT REPORT UP TO:&
  243.  
  244.  
  245.  
  246.  
  247.  
  248.  
  249.  
  250.  
  251.  
  252.  
  253.  
  254.  
  255. \
  256. SELECT_DR
  257. SELECT_FROM1
  258. SELECT_THRU1
  259. TO_DATE
  260. \
  261. \R NEW     
  262. IMMUNISATION EXCEPTION REPORT ON :&           FOR DOCTOR &
  263. PATIENT NAME                  ADDRESS                AREA                    DATE/BIRTH  CODE  DATE    STATUS      STATUS  AGE
  264. ===============================================================================================================================
  265. &                             &                      &                       &          [&   ] &         &                 &
  266. THIS PROGRAM PRINTS OUT ALL IMMUNISATIONS THAT DO NOT APPEAR TO BE UP TO DATE ON :&
  267. IT DOES NOT GIVE A LIST OF RECALLS DUE!!!!!!!! BUT INCLUDES DATE 0F BIRTH FROM :&           TO :&
  268. THESE SHOULD BE ATTENDED TO TODAY AND NONE SHOULD APPEAR ON THE NEXT PRINTOUT!!! AGES FROM 4.5 UP SHOULD HAVE A "B" FOR BOOSTER
  269.  
  270.  
  271.  
  272.  
  273.  
  274.  
  275.  
  276.  
  277.  
  278.  
  279.  
  280.  
  281.  
  282.  
  283.  
  284.  
  285.  
  286.  
  287.  
  288.  
  289.  
  290.  
  291.  
  292.  
  293.  
  294.  
  295.  
  296.  
  297.  
  298.  
  299.  
  300.  
  301.  
  302.  
  303.  
  304.  
  305.  
  306.  
  307.  
  308.  
  309.  
  310. \
  311. TD
  312. SELECT_DR
  313. PATIENT.NAME
  314. ADDRESS1
  315. AREA
  316. DATE.OF.BIRTH
  317. COD[3]
  318. COD.D[3]
  319. REC_FIELD
  320. AGE
  321. TO_DATE
  322. SELECT_FROM1
  323. SELECT_THRU1
  324. \
  325.